home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun: Super Starter Pak 2 / rerun-super-starter-pak-ii-1991-side-b.d64 / label base (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-01-01  |  5.8 KB  |  204 lines
  1. 10 rem label base 64/128
  2. 20 rem by bob kodadek
  3. 30 :
  4. 40 ps=0:ll=3:q=250:c=40:mo=64:ml=828:yr=782:print chr$(142)
  5. 50 if peek(40960)=0 then mo=128:ml=4864:poke828,183:if peek(215) then c=80
  6. 60 sp$=chr$(32):m$=chr$(44):if mo=128 then yr=8:q=350
  7. 70 if c=80 then poke53265,peek(53265) and 239:poke 53296,1:rem fast mode
  8. 80 b$=chr$(13)+chr$(18):o$=chr$(146):for i=0 to 6:read fd$(i),l%(i):next
  9. 90 for i=3 to c:l$=l$+chr$(163):next:fori=0 to 39:e$=e$+sp$:next
  10. 100 for i=0 to 89:read by:poke ml+i,by:ck=ck+by:next:if ps then print chr$(14)
  11. 110 if ck<>14598 then print"data error":end
  12. 120 dim r$(q,7),k(q):fori=1 to q:k(i)=i:next
  13. 130 :
  14. 140 rem - menu 1 -
  15. 150 close1:close5:close15:gosub300:print
  16. 160 print b$ spc(5)"f1" o$" - load file"
  17. 170 print b$ spc(5)"f3" o$" - save file"
  18. 180 print b$ spc(5)"f5" o$" - select records"
  19. 190 print b$ spc(5)"f7" o$" - directory "
  20. 200 print b$ spc(5)"f2" o$" - enter data"
  21. 210 print b$ spc(5)"f4" o$" - alphabetize"
  22. 220 print b$ spc(5)"f6" o$" - print menu"
  23. 230 gosub310:kp=asc(a$)-132:if kp<1 or kp>7 then 230
  24. 240 on kp gosub430,560,650,1330,980,880,1590
  25. 250 goto150
  26. 260 :
  27. 270 x=20:y=0:gosub280:print e$:return
  28. 280 if mo=64 then poke781,x:poke yr,y:poke783,0:sys65520:return
  29. 290 poke7,x:poke yr,y:poke5,0:sys65520:return
  30. 300 print chr$(147)" label base" mo"- file: "fs$:print spc(1) l$:return
  31. 310 a$="":get a$:if a$="" then 310
  32. 320 return
  33. 330 f$="":input f$:le=len(f$):return
  34. 340 input#15,en$,em$,et$,es$:en=val(en$):return
  35. 350 gosub270:x=19:y=0:gosub280
  36. 360 close 5:close 15
  37. 370 print b$ "drive status:" o$+sp$+en$+m$+em$+m$+et$+m$+es$
  38. 380 print:print"press return"
  39. 390 gosub310:ifa$<>chr$(13)then 390
  40. 400 return
  41. 410 :
  42. 420 rem - load file -
  43. 430 print:print"load which file";:gosub330
  44. 440 if le<1 then return
  45. 450 if f$="new" then nr=0:rn=0:fs$="":return
  46. 460 open 15,8,15:open 5,8,5,"lb."+f$+",s,r"
  47. 470 gosub340:if en<>0 then 350
  48. 480 print:print"reading " f$;:rn=1
  49. 490 for i=rn to q:for n=0 to 6:input#5,r$(i,n)
  50. 500 if st=64 then520
  51. 510 next n:next i
  52. 520 nr=i:for i=1 to q:k(i)=i:next
  53. 530 fs$=f$:goto350
  54. 540 :
  55. 550 rem - save file -
  56. 560 print:print"save to filename";:gosub330
  57. 570 if le<1 then return
  58. 580 open 15,8,15:print#15,"s0:lb."+f$
  59. 590 open 5,8,5,"lb."+f$+",s,w":gosub340
  60. 600 print:print"writing " f$;:if en<>0 then350
  61. 610 for i=1 to nr:for n=0 to 6:if r$(k(i),n)="" then r$(k(i),n)=sp$
  62. 620 print#5,r$(k(i),n):next n:next i:goto350
  63. 630 :
  64. 640 rem - select records -
  65. 650 gosub1080:gosub310
  66. 660 if a$=chr$(13) then return
  67. 670 if a$="f"then if nr then rn=1
  68. 680 if a$="l"then rn=nr
  69. 690 if a$="r"and nr then gosub1500:goto650
  70. 700 if a$="p"and rn>1 then rn=rn-1
  71. 710 if a$="n"and rn<nr then rn=rn+1
  72. 720 if a$="k"then gosub1430
  73. 730 if a$="d"and nr then gosub1260:ifrn>nrthenrn=rn-1
  74. 740 if a$="a"then gosub980
  75. 750 if a$="e"and nr then gosub1160
  76. 760 if a$=chr$(16) then gosub1690
  77. 770 if a$="?"then gosub790
  78. 780 close4:goto650
  79. 790 gosub300:x=5:y=8:gosub280:print"help menu":print
  80. 800 print spc(8)"f - first record":print spc(8)"n - next record"
  81. 810 print spc(8)"p - previous record":print spc(8)"l - last record"
  82. 820 print spc(8)"k - key field match":print spc(8)"a - add records"
  83. 830 print spc(8)"d - delete record":print spc(8)"r - replace record"
  84. 840 print spc(8)"e - edit current record"
  85. 850 gosub380:return
  86. 860 :
  87. 870 rem - sort records
  88. 880 y=nr:print:print"sorting";
  89. 890 y=int(y/2):ify=0then return
  90. 900 j=1:k=nr-y
  91. 910 i=j
  92. 920 l=i+y:print".";:if r$(k(i),0)<=r$(k(l),0) then 940
  93. 930 t=k(i):k(i)=k(l):k(l)=t:i=i-y:if i>0 then 920
  94. 940 j=j+1:if j>k then 890
  95. 950 goto910
  96. 960 :
  97. 970 rem - entry
  98. 980 t=nr+1:if t>q then return
  99. 990 rn=t:nr=t:flag=1:for i=0 to 6:r$(rn,i)="":next
  100. 1000 gosub1080:for i=0 to 6:x=8+i:y=11:gosub280:poke yr,l%(i)
  101. 1010 sys ml:c1=peek(yr):if c1=0 then r$(rn,i)=sp$:goto1030
  102. 1020 for s=1 to c1:r$(rn,i)=r$(rn,i)+chr$(peek(255+s)):next s
  103. 1030 next i:k(rn)=rn:gosub270:y=6:gosub280:print"press space bar for another"
  104. 1040 gosub310:ifa$=sp$ then 980
  105. 1050 flag=0:return
  106. 1060 :
  107. 1070 rem - display record -
  108. 1080 gosub300:x=4:y=5:gosub280:print"record #"rn"of"nr
  109. 1090 x=8:y=0:gosub280:for i=0 to 6:ld=36-(24-l%(i))
  110. 1100 print spc(8-len(fd$(i))) fd$(i)" < "r$(k(rn),i) tab(ld)">":next
  111. 1110 if flag then return
  112. 1120 if flag=0 then x=18:y=8:gosub280:print "(press ctrl-p to print)"
  113. 1130 x=20:y=1:gosub280:print"select - f, n, p, l, k, a, d, r, e, ?"
  114. 1140 return
  115. 1150 :
  116. 1160 rem - edit record  -
  117. 1170 gosub300:x=4:y=5:gosub280:print"record #"rn"of"nr
  118. 1180 x=8:y=0:gosub280:for i=0 to 6
  119. 1190 if r$(k(rn),i)="" or r$(k(rn),i)=sp$ then r$(k(rn),i)="*"
  120. 1200 print spc(8-len(fd$(i))) fd$(i)": "r$(k(rn),i)
  121. 1210 print chr$(145) tab(10);:open1,0:input#1,r$(k(rn),i)
  122. 1220 if r$(k(rn),i)="*" then r$(k(rn),i)=""
  123. 1230 print:close1:next:return
  124. 1240 :
  125. 1250 rem - delete record -
  126. 1260 gosub270:y=5:gosub280:print"delete this record? (y or n)"
  127. 1270 gosub310:if a$<>"y" then return
  128. 1280 for n=0 to 6:r$(k(rn),n)=r$(nr,n):r$(nr,n)="":next
  129. 1290 for i=1 to nr:ifk(i)=nr then k(i)=k(nr):k(nr)=0:nr=nr-1:return
  130. 1300 next:return
  131. 1310 :
  132. 1320 rem - read directory
  133. 1330 gosub300:print:print
  134. 1340 open15,8,15:open1,8,0,"$0:lb.*":gosub340:ifen<>0then350
  135. 1350 n$=chr$(0):get#1,a$,a$
  136. 1360 get#1,a$,a$:if a$=""then 1400
  137. 1370 get#1,a$,c$:print asc(a$+n$)+asc(c$+n$)*256;
  138. 1380 get#1,a$:ifa$=""then print:goto1360
  139. 1390 printa$;:goto1380
  140. 1400 goto360
  141. 1410 :
  142. 1420 rem - key string -
  143. 1430 gosub270:y=6:gosub280
  144. 1440 print"enter key -";:inputk$
  145. 1450 for i=1 to nr
  146. 1460 if k$=left$(r$(k(i),0),len(k$)) then rn=i:return
  147. 1470 next:return
  148. 1480 :
  149. 1490 rem - replace record
  150. 1500 gosub270:y=5:gosub280:print"replace this record? (y or n)"
  151. 1510 gosub310:if a$<>"y" then return
  152. 1520 for i=0 to 6:r$(k(rn),i)="":next
  153. 1530 gosub1080:for i=0 to 6:x=8+i:y=11:gosub280:poke yr,l%(i)
  154. 1540 sysml:c1=peek(yr):if c1=0 then r$(k(rn),i)=sp$:goto1560
  155. 1550 for s=1 to c1:r$(k(rn),i)=r$(k(rn),i)+chr$(peek(255+s)):next s
  156. 1560 next i:return
  157. 1570 :
  158. 1580 rem - print menu -
  159. 1590 gosub300:print:print
  160. 1600 print b$ spc(5)"f1" o$" - print current record"
  161. 1610 print b$ spc(5)"f3" o$" - print all records"
  162. 1620 print b$ spc(5)"f5" o$" - print phone list"
  163. 1630 gosub310:if a$=chr$(13) then return
  164. 1640 kp=asc(a$)-132:if kp<1 or kp>3  then 1630
  165. 1650 on kp gosub1690,1800,1850
  166. 1660 close4:goto1590
  167. 1670 :
  168. 1680 rem - print record -
  169. 1690 cn=1:open4,4,ps:close4:ss=st:if ss then return
  170. 1700 print:print"how many labels? 1";:input"[157][157][157]";cn
  171. 1710 open4,4,ps:if cn <1 then return
  172. 1720 for i=1 to cn
  173. 1730 print#4,r$(k(rn),1) chr$(32) r$(k(rn),0)
  174. 1740 print#4,r$(k(rn),2)
  175. 1750 print#4,r$(k(rn),3)","chr$(32) r$(k(rn),4) chr$(32);
  176. 1760 print#4,r$(k(rn),5)
  177. 1770 for s=1 to ll:print#4:next s:next i:return
  178. 1780 :
  179. 1790 rem - print all records -
  180. 1800 t=rn:rn=1:gosub1690:if cn<1 or ss then return
  181. 1810 rn=rn+1:gosub1720:if rn<nr then 1810
  182. 1820 rn=t:return
  183. 1830 :
  184. 1840 rem - print phone list -
  185. 1850 lc=0:lf=5:open4,4,ps:close4:if st then return
  186. 1860 open4,4,ps:for i=1 to nr:ns=0
  187. 1870 for n=0 to 2:print#4,r$(k(i),n) chr$(32);
  188. 1880 ns=ns+len(r$(k(i),n))+1:next n
  189. 1890 ns=ns+len(r$(k(i),6)):nd=79-ns
  190. 1900 for d=1 to nd:print#4,"-";:next d
  191. 1910 print#4,r$(k(i),6):lc=lc+1:if lc<60 then 1930
  192. 1920 for lc=0 to lf:print#4:next lc:lc=0
  193. 1930 next i:return
  194. 1940 :
  195. 1950 data last,15,first,18,street,24
  196. 1960 data city,24,state,2,zip,12,phone,12
  197. 1970 :
  198. 1980 data 132,252,160,0,132,251,240,49,32,228,255,240,251,164,251,201,13
  199. 1990 data 208,6,169,32,32,210,255,96,201,20,240,40,196,252,240,231,201
  200. 2000 data 32,144,227,201,34,240,223,201,161,176,4,201,128,176,215,153,0
  201. 2010 data 1,230,251,32,210,255,169,161,32,210,255,169,157,32,210,255,208
  202. 2020 data 195,192,0,240,240,198,251,169,32,32,210,255,169,157,32,210,255
  203. 2030 data 32,210,255,208,223
  204.